home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
Library
/
Out2.mod
< prev
next >
Wrap
Text File
|
1995-06-29
|
4KB
|
189 lines
(*************************************************************************
$RCSfile: Out2.mod $
Description: Extensions to module Out.
Created by: fjc (Frank Copeland)
$Revision: 1.4 $
$Author: fjc $
$Date: 1995/01/26 00:40:27 $
Copyright © 1994-1995, Frank Copeland.
This file is part of the Oberon-A Library.
See Oberon-A.doc for conditions of use and distribution.
Log entries are at the end of the file.
*************************************************************************)
<* STANDARD- *>
MODULE Out2;
IMPORT Kernel, d := Dos, conv := Conversions, str := Strings, Reals, Out;
PROCEDURE Bin * ( x : LONGINT; n : INTEGER );
VAR s : ARRAY 33 OF CHAR; len : INTEGER;
BEGIN (* Bin *)
IF conv.IntToStr (x, 2, 0, " ", s) THEN
len := str.Length (s);
WHILE n > len DO Out.Char (" "); DEC (n) END;
Out.String (s);
END
END Bin;
PROCEDURE Oct * ( x : LONGINT; n : INTEGER );
VAR s : ARRAY 13 OF CHAR; len : INTEGER;
BEGIN (* Oct *)
IF conv.IntToStr (x, 8, 0, " ", s) THEN
len := str.Length (s);
WHILE n > len DO Out.Char (" "); DEC (n) END;
Out.String (s);
END
END Oct;
PROCEDURE Hex * ( x : LONGINT; n : INTEGER );
VAR s : ARRAY 10 OF CHAR; len : INTEGER;
BEGIN (* Hex *)
IF conv.IntToStr (x, 16, 0, " ", s) THEN
len := str.Length (s);
WHILE n > len DO Out.Char (" "); DEC (n) END;
Out.String (s);
END
END Hex;
PROCEDURE RealFix * ( x : REAL; n, k : INTEGER );
CONST maxD = 9;
VAR e, i : INTEGER; sign : CHAR; x0 : REAL; d : ARRAY maxD OF CHAR;
(*------------------------------------*)
PROCEDURE seq ( ch : CHAR; n : LONGINT );
BEGIN (* seq *)
WHILE n > 0 DO Out.Char (ch); DEC (n) END
END seq;
(*------------------------------------*)
PROCEDURE dig (n : INTEGER);
BEGIN (* dig *)
WHILE n > 0 DO
DEC (i); Out.Char (d [i]); DEC (n)
END;
END dig;
BEGIN (* RealFix *)
e := Reals.Expo (x);
IF k < 0 THEN k := 0 END;
IF e = 0 THEN
seq (" ", n - k - 2); Out.Char ("0"); seq (" ", k + 1)
ELSIF e = 255 THEN
Out.String ("NaN"); seq (" ", n - 4)
ELSE
e := (e - 127) * 77 DIV 256;
IF x < 0.0 THEN sign := "-"; x := -x ELSE sign := " " END;
IF e >= 0 THEN (* x >= 1.0, 77/256 = log 2 *) x := x / Reals.Ten (e)
ELSE (* x < 1.0 *) x := Reals.Ten (-e) * x
END;
IF x >= 10.0 THEN x := 0.1 * x; INC (e) END;
(* 1 <= x < 10 *)
IF k + e >= maxD - 1 THEN k := maxD - 1 - e
ELSIF k + e < 0 THEN k := -e; x := 0.0
END;
x0 := Reals.Ten (k + e); x := x0 * x + 0.5;
IF x >= 10.0 * x0 THEN INC (e) END;
(* e = no. of digits before decimal point *)
INC (e); i := k + e; Reals.Convert (x, i, d);
IF e > 0 THEN
seq (" ", n - e - k - 2); Out.Char (sign); dig (e); Out.Char (".");
dig (k)
ELSE
seq (" ", n - k - 3); Out.Char (sign); Out.Char ("0"); Out.Char (".");
seq ("0", -e); dig (k + e)
END
END
END RealFix;
PROCEDURE RealHex * ( x : REAL );
VAR d : ARRAY 9 OF CHAR;
BEGIN (* RealHex *)
Reals.ConvertH (x, d); d [8] := 0X; Out.String (d)
END RealHex;
PROCEDURE LongRealFix * ( x : LONGREAL; n, k : INTEGER );
BEGIN (* LongRealFix *)
RealFix (SHORT (x), n, k)
END LongRealFix;
PROCEDURE LongRealHex * ( x : LONGREAL );
BEGIN (* LongRealHex *)
RealHex (SHORT (x))
END LongRealHex;
PROCEDURE Set * ( x : SET );
VAR i : INTEGER; first : BOOLEAN;
BEGIN (* Set *)
Out.Char ("{");
i := 0; first := TRUE;
FOR i := 0 TO 31 DO
IF i IN x THEN
IF ~first THEN Out.Char (",") ELSE first := FALSE END;
Out.Int (i, 0)
END
END;
Out.Char ("}");
END Set;
PROCEDURE Bool * ( x : BOOLEAN );
BEGIN (* Bool *)
IF x THEN Out.String ("TRUE") ELSE Out.String ("FALSE") END
END Bool;
PROCEDURE Pair ( ch : CHAR; x : LONGINT );
BEGIN (* Pair *)
Out.Char (ch);
Out.Char (CHR (x DIV 10 + 30H));
Out.Char (CHR (x MOD 10 + 30H))
END Pair;
PROCEDURE Time * ( t : LONGINT );
BEGIN (* Time *)
Pair (" ", t DIV 4096 MOD 32);
Pair (":", t DIV 64 MOD 64);
Pair (":", t MOD 64);
END Time;
PROCEDURE Date * ( t, d : LONGINT );
BEGIN (* Date *)
Pair (" ", d MOD 32);
Pair (".", d DIV 32 MOD 16);
Pair (".", d DIV 512 MOD 128);
Time (t)
END Date;
END Out2.